home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / Pod / Simple / Progress.pm < prev    next >
Encoding:
Text File  |  2009-06-26  |  2.4 KB  |  94 lines
  1.  
  2. require 5;
  3. package Pod::Simple::Progress;
  4. $VERSION = "1.01";
  5. use strict;
  6.  
  7. # Objects of this class are used for noting progress of an
  8. #  operation every so often.  Messages delivered more often than that
  9. #  are suppressed.
  10. #
  11. # There's actually nothing in here that's specific to Pod processing;
  12. #  but it's ad-hoc enough that I'm not willing to give it a name that
  13. #  implies that it's generally useful, like "IO::Progress" or something.
  14. #
  15. # -- sburke
  16. #
  17. #--------------------------------------------------------------------------
  18.  
  19. sub new {
  20.   my($class,$delay) = @_;
  21.   my $self = bless {'quiet_until' => 1},  ref($class) || $class;
  22.   $self->to(*STDOUT{IO});
  23.   $self->delay(defined($delay) ? $delay : 5);
  24.   return $self;
  25. }
  26.  
  27. sub copy { 
  28.   my $orig = shift;
  29.   bless {%$orig, 'quiet_until' => 1}, ref($orig);
  30. }
  31. #--------------------------------------------------------------------------
  32.  
  33. sub reach {
  34.   my($self, $point, $note) = @_;
  35.   if( (my $now = time) >= $self->{'quiet_until'}) {
  36.     my $goal;
  37.     my    $to = $self->{'to'};
  38.     print $to join('',
  39.       ($self->{'quiet_until'} == 1) ? () : '... ',
  40.       (defined $point) ? (
  41.         '#',
  42.         ($goal = $self->{'goal'}) ? (
  43.           ' ' x (length($goal) - length($point)),
  44.           $point, '/', $goal,
  45.         ) : $point,
  46.         $note ? ': ' : (),
  47.       ) : (),
  48.       $note || '',
  49.       "\n"
  50.     );
  51.     $self->{'quiet_until'} = $now + $self->{'delay'};
  52.   }
  53.   return $self;
  54. }
  55.  
  56. #--------------------------------------------------------------------------
  57.  
  58. sub done {
  59.   my($self, $note) = @_;
  60.   $self->{'quiet_until'} = 1;
  61.   return $self->reach( undef, $note );
  62. }
  63.  
  64. #--------------------------------------------------------------------------
  65. # Simple accessors:
  66.  
  67. sub delay {
  68.   return $_[0]{'delay'} if @_ == 1; $_[0]{'delay'} = $_[1]; return $_[0] }
  69. sub goal {
  70.   return $_[0]{'goal' } if @_ == 1; $_[0]{'goal' } = $_[1]; return $_[0] }
  71. sub to   {
  72.   return $_[0]{'to'   } if @_ == 1; $_[0]{'to'   } = $_[1]; return $_[0] }
  73.  
  74. #--------------------------------------------------------------------------
  75.  
  76. unless(caller) { # Simple self-test:
  77.   my $p = __PACKAGE__->new->goal(5);
  78.   $p->reach(1, "Primus!");
  79.   sleep 1;
  80.   $p->reach(2, "Secundus!");
  81.   sleep 3;
  82.   $p->reach(3, "Tertius!");
  83.   sleep 5;
  84.   $p->reach(4);
  85.   $p->reach(5, "Quintus!");
  86.   sleep 1;
  87.   $p->done("All done");
  88. }
  89.  
  90. #--------------------------------------------------------------------------
  91. 1;
  92. __END__
  93.  
  94.